perm filename PT2D.2[MSS,LCS] blob sn#242183 filedate 1976-10-18 generic text, type T, neo UTF8
00100		SUBROUTINE PT2
00200		INTEGER VALID
00300		DIMENSION VALID(6),BARS(509)
00400		DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
00500	C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00600	
00700	C  ADD MORE TO VALID LATER *****
00750		COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00775		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
00800		COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
00900		1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512) 
01000		1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
01100		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
01200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
01300		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
01400		1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
01500		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
01600		1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81)),(TOT,KBAR(2))
01700		1,(BARS,KBAR(4))
01800	CC	1,(RSTF,RSTFAC(100))
01900	C  TRNSP'S Bb, F, BBb, A, G, Eb.
02000	5	FORMAT(F,2I)
02100	CCC	IF(RS.NE.'OLD')GO TO 2000
02200		CALL GETFIL('BARS')
02300		CALL FASTIN(KBAR,512)
02350		CALL FASTIN(RSTFAC,128)
02400	2000	TYPE 144
02500	144	FORMAT(' STAFF SIZE, TRANSP.  '$)
02600		ACCEPT 5,SIZE,LL
02700		IF(SIZE.NE.0)GO TO 1
02800		SIZE=1
02900		GO TO 3
03000	1	DO 2 K=1,KT
03100	2	BARS(K)=BARS(K)*SIZE
03200		TOT=TOT*SIZE
03205	3	IF(RSTJ2.EQ.0)RSTJ2=1 
03210		RA=JPG*SIZE*RSTJ2
03215		MPG=10./RA
03220	C  MPG=NUM OF BRACES PER PAGE.
03225		SPG=10./MPG
03230	C  SPG IS SPACE TO BE SET ABOVE STAFF 0
03235		RA=(RSTJ2*SIZE)/RPSZ(1)
03240		DO 141 K=1,JPG
03245	141	RPSZ(K)=RPSZ(K)*RA
03250		LPG=JPG
03300		IF(MOD(LL,7).EQ.0)GO TO 140
03400		DO 40 L=1,6
03500	40	IF(LL.EQ.VALID(L))GO TO 140
03600		TYPE 240
03700		GO TO 2000
03800	240	FORMAT(' THIS TRANSP NOT OFFERED')
03900	
04000	140	TYPE 90,KT
04100		RA=0
04200	90	FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
04300		
04400		NT=TOT/QLINE
04500	C  USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
04600		T=NT
04700	16	AV=TOT/T
04800		X=AV
04900		JT=T
05000	C JT=TOTAL NUM OF LINES
05100		NN=KT/JT
05200		NX=KT-JT*NN
05300		DO 401 K=1,JT-NX
05400	401	NBAR(K)=NN
05500		IF(NX.EQ.0)GO TO 408
05600		M=NN+1
05700		DO 402 K=JT-NX+1,JT
05800	402	NBAR(K)=M
05900	
06000	408	M=0
06100		KK=0
06200		B=0
06300		DO 403 K=1,JT
06400		T=B
06500		B=0
06600		Y=BARS(M)
06700		Z=BARS(M+1)
06800	C  GET LAST OF PREV. LINE, FIRST OF THIS LINE
06900		DO 404 J=1,NBAR(K)
07000		M=M+1
07100	C  M IS BAR COUNTER
07200	404	B=B+BARS(M)
07300		IF(T.EQ.0)GO TO 403
07400		X=ABS(B-T)
07500		IF(T.GT.B)GO TO 406
07600	CC	IF(NBAR(K).EQ.1)GO TO 403
07700		IF(X.LE.Z)GO TO 403
07800		JJ=K
07900		JK=K-1
08000		W=-Z
08100		GO TO 407
08200	406	IF(X.LE.Y)GO TO 403
08300	CC	IF(NBAR(K-1).EQ.1)GO TO 403
08400		JK=K
08500		JJ=K-1
08600	407	IF(NBAR(JJ).EQ.1)GO TO 403
08700		KK=-1
08800		NBAR(JJ)=NBAR(JJ)-1
08900		NBAR(JK)=NBAR(JK)+1
09000		B=B+W
09100	403	CONTINUE
09200		IF(KK)GO TO 408
09300	C  GO BACK IF MORE TO SHUFFLE
09400		J=1
09500		TYPE 306,AV
09600		DO 305 K=1,JT
09700		L=NBAR(K)-1+J
09800		T=0
09900		DO 8 M=J,L
10000	8	T=T+BARS(M)
10100	306	FORMAT(1XF4.0,3X8F4.0)
10200		TYPE 306,T,(BARS(N),N=J,L)
10300	305	J=L+1
10400	
10401		RPG=JT
10450		RPG=RPG/MPG
10500	105	TYPE 104,RPG,JT
10600	104	FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
10700	C  FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
10800		KA=0
10900		ACCEPT 5,T,N,KL
11000	C  TYPE 0,n  TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
11100		IF(KL.NE.0)GO TO 110
11200	C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
11300		IF(T.EQ.0)GO TO 11
11400		JT=T
11500		IF(N.EQ.0)GO TO 16
11600	C N=0 MEANS T= NUM OF LINES DESIRED.
11700	
11800	111	FORMAT(36I)
11900	110	REREAD 111,NBAR
12000	911	DO 112 K=36,1,-1
12100		KP=NBAR(K)
12200		KA=KA+KP
12300	112	IF(KP.EQ.0.AND.KA.EQ.0)KL=K
12400		IF(KA.NE.KT)GO TO 105
12500	C  MISMATCH!
12600		N=26-2*MOD(KL-1,12)
12700		IF(N.EQ.26)N=0
12800	C  TO SPACE OUT STAVES VERTICALLY
12900	CC	IF(IPG)GO TO 11
13000	CC	IF(NBAR(1).NE.0)GO TO 11
13100	CC	DO 711 K=1,36
13200	CC	IF(K.GT.J)IV(K)=0
13300	CC711	NBAR(K)=IV(K)
13400	CC	GO TO 911
13500	11	CALL WRTPAG
13600		END